Attribute VB_Name = "CommonRoutines"
Sub makeone()
'
' Macro9 Macro
'
'


    Selection.HomeKey Unit:=wdLine
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(-0.13)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    Selection.TypeText Text:="1."
End Sub

Sub xmlexample()
    Dim xDoc As New MSXML2.DOMDocument
    xDoc.Load ("C:\Users\Ryan\Documents\summer2008\opensongstuff\songs\A Greater Song.xml")
    Dim xmlRecord As MSXML2.IXMLDOMElement
    
    MsgBox xDoc.LastChild.Text
    
    
    Dim xNode As MSXML2.IXMLDOMNode
    Set xNode = xDoc.ParentNode
    Dim xNodeChild As MSXML2.IXMLDOMNode
    xDoc.createAttribute "newattribute"
    Dim xNodeChildAttribute As MSXML2.IXMLDOMAttribute

    
    
    
    MsgBox "hello"
    
    
    
''
''    Set xmlRecord = asfs.createElement("record") 'make the <record /> tag
''    xmlRecord.setAttribute "JobID", "126"
''    xmlRecord.setAttribute "Workstation", "LARCHMONT"
'
    asfs.appendChild xmlRecord
    
    
    
    Debug.Print "here you are"
    


End Sub



Sub ReadXML()
Dim xml_doc As New DOMDocument
Dim nde_test As IXMLDOMElement
Dim nde_test2 As IXMLDOMElement

xml_doc.Load "C:\Test\test.xml"




For Each nde_test In xml_doc.SelectNodes("//test")

    Debug.Print nde_test.SelectSingleNode("nameplate").Text
    
Next


End Sub


Sub writeSong()


Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Dim blnDidItOpen As Boolean
Dim xml_doc As New DOMDocument
Dim onode As IXMLDOMElement
Dim onode2 As IXMLDOMElement
makefontcool
blnDidItOpen = xml_doc.Load("C:\Users\Ryan\Documents\summer2008\opensongstuff\songs\A Greater Song")
If blnDidItOpen Then
   With ows    'the existing reference to active sheet
       For Each onode In xml_doc.SelectNodes("//song")
            For Each onode2 In onode.SelectNodes("//title")
                Selection.TypeText onode2.Text
                Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
                makefontcool
                Selection.Font.Size = "14"
                Selection.endKey Unit:=wdLine
            Next
            Selection.TypeParagraph
            Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
            Selection.Font.Size = "10"
            Selection.endKey Unit:=wdLine
            Selection.TypeParagraph
            For Each onode2 In onode.SelectNodes("//lyrics")
                Selection.TypeText onode2.Text
            Next
            replaceadd9
            Selection.TypeParagraph
            Selection.TypeParagraph
            Selection.TypeText "Capo:"
            Selection.TypeText 0
            Selection.TypeText " "
            Selection.TypeText "? ? Tempo:?"
            Selection.TypeText " "
            For Each onode2 In onode.SelectNodes("//title")
                Selection.TypeText UCase(Right(onode2.Text, 3))
            Next
            Selection.TypeText ".? "
            For Each onode2 In onode.SelectNodes("//author")
                Selection.TypeText onode2.Text
            Next
            
            Selection.TypeText Text:=" "
            Selection.InsertSymbol (169)
            Selection.TypeText (" ")
            For Each onode2 In onode.SelectNodes("//copyright")
                Selection.TypeText onode2.Text
            Next
            
            Selection.TypeText Text:=" Scripture:?"
            Selection.TypeParagraph
            Selection.TypeParagraph
            
       Next
   End With
Else
    MsgBox "loading failed for multitude of reasons..."
End If

NewMacros.Macro15


End Sub


Sub replaceadd9()

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "add9"
        .Replacement.Text = "9"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll







End Sub



Sub makefontcool()

    If Len(Selection.Text) > 1 Then
    Debug.Print Selection.Text
    Dim iLeftLineStyle As Long
    Dim iLeftLineWidth As Long
    Dim iLeftLineColor As Long
    
    Dim iBottomLineStyle As Long
    Dim iBottomLineWidth As Long
    Dim iBottomLineColor As Long
    
    With Selection.ParagraphFormat
        With .Borders(wdBorderLeft)
        If Not .LineStyle = wdLineStyleNone Then
            iLeftLineStyle = .LineStyle
            iLeftLineWidth = .LineWidth
            iLeftLineColor = .Color
        End If
        End With
        With .Borders(wdBorderBottom)
        If Not .LineStyle = wdLineStyleNone Then
            iBottomLineStyle = .LineStyle
            iBottomLineWidth = .LineWidth
            iBottomLineColor = .Color
        End If
        End With
    End With
    
    Selection.ClearFormatting
    'WordBasic.ClearAllFormatting
    
    With Selection.ParagraphFormat
        With .Borders(wdBorderLeft)
            .LineStyle = iLeftLineStyle
            .LineWidth = iLeftLineWidth
            .Color = iLeftLineColor
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = iBottomLineStyle
            .LineWidth = iBottomLineWidth
            .Color = iBottomLineColor
        End With
        With .Borders
            .DistanceFromTop = 1
            .DistanceFromLeft = 4
            .DistanceFromBottom = 1
            .DistanceFromRight = 4
            .Shadow = False
        End With
    End With
    

    
    
    
    
    With Selection.Font
        .Name = "Courier New"
        .Size = 10
        .Bold = True
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
    End With
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0)
        .RightIndent = InchesToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceMultiple
        .LineSpacing = LinesToPoints(1.15)
        .Alignment = wdAlignParagraphLeft
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = InchesToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
    End With
    
    
    
    End If


End Sub














Sub Create_XML_Recordset()
    Dim rst As ADODB.Recordset
    Dim str As ADODB.Stream
    Dim stCon As String
     
     'A named range is used in the example.
    Const stSQL As String = "SELECT * FROM [Report]"
     
     'The connection string.
    stCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisDocument.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes"";"
     'Instantiate the ADODB's objects.
    Set rst = New ADODB.Recordset
    Set str = New ADODB.Stream
     
    With rst
        .CursorLocation = adUseClient
        .Open stSQL, stCon, adOpenStatic, adLockReadOnly, adCmdText
         'Save the recordset into the stream.
        .Save str, adPersistXML
        .Close
        With str
            .SaveToFile "C:\Report.xml", adSaveCreateOverWrite
            .Close
        End With
    End With
     
     'Release object from memory.
    Set str = Nothing
    Set rst = Nothing
     
End Sub













Sub maketwo()

        Selection.HomeKey Unit:=wdLine
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(-0.13)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    Selection.TypeText Text:="2."



End Sub


Sub findplacetoinsert()
    Dim str As String
    
    str = "Jason"
    Selection.HomeKey Unit:=wdStory

    
    Dim loopforever As Boolean
    loopforever = True
    While loopforever
        Selection.endKey Unit:=wdLine
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        If Selection.Font.Size > 11 Then
            Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If Selection.Text = ")" Then
                Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                If ((Selection.Text = "#") Or (Selection.Text = "b")) Then
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                End If
                getKey = Selection.Text
                Selection.Text = strEndKey
                loopforever = False
            Else
                MsgBox ("Error in getKey function")
            End If
        End If
    Wend


End Sub
